home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DRIVES.SWG / 0021_VOLABEL2.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  4KB  |  125 lines
  1. {
  2. Could somebody help me out here? I'm trying to Write a
  3. Program that reads the File names and their attributes from
  4. disk/drive.
  5.  
  6. Unit volLabel;
  7.  
  8.   Type String11 = String[11];
  9.   Function  GetCurrentVolumeLabel : String11;
  10.   Procedure DelVolumeLabel(CurrentVolumeLabel:String11);
  11.   Procedure WriteVolumeLabel(CurrentVolumeLabel:String11);
  12.   ( to change a volume Label: delete old, then Write new )
  13. }
  14.  
  15. (* Implementation *)
  16.  
  17. Uses
  18.   Dos;
  19.  
  20. Var
  21.   oldir : String; { only For test Program }
  22.  
  23. Type
  24.   ExtendedFCBType = Record
  25.                       ExtendedFCBflag : Byte;
  26.                       Reserved1       : Array[1..5] of Byte;
  27.                       Attr            : Byte;
  28.                       DriveID         : Byte;
  29.                       FileName        : Array[1..8] of Char;
  30.                       FileExt         : Array[1..3] of Char;
  31.                       CurrentBlockNum : Word;
  32.                       RecordSize      : Word;
  33.                       FileSize        : LongInt;
  34.                       PackedDate      : Word;
  35.                       PackedTime      : Word;
  36.                       Reserved2       : Array[1..8] of Byte;
  37.                       CurrentRecNum   : Byte;
  38.                       RandomRecNum    : LongInt;
  39.                     end;
  40.  
  41. Type String11 = String[11];
  42. Function GetCurrentVolumeLabel : String11;
  43. Var
  44.   CurrentDrive: String;
  45.   VolumeLabel : SearchRec;  { defined in the Dos Unit }
  46.   i : Word;
  47. begin                    { 12345678901 }
  48.   GetCurrentVolumeLabel:= 'no Label   ';
  49.   getdir(0,CurrentDrive); {in Dos Unit }
  50.   CurrentDrive:= copy(CurrentDrive,1,3) + '*.*';
  51.   {get Volume Label in A: drive}
  52.   findfirst(CurrentDrive,VolumeID,VolumeLabel);
  53.   if Doserror=0 then
  54.     With VolumeLabel do
  55.       begin
  56.         {remove period}
  57.         delete(VolumeLabel.name,pos('.',VolumeLabel.name),1);
  58.         { pad to 11 Chars }
  59.         For i:= length(name) to 11 do name:= name + ' ';
  60.         GetCurrentVolumeLabel:= name;
  61.       end; { With VolumeLabel}
  62. end; {of GetCurrentVolumeLabel }
  63.  
  64. Procedure DelVolumeLabel(CurrentVolumeLabel:String11);
  65. {delete volume Label from disk in current drive}
  66. Var
  67.   regs : Registers;
  68.   FCB  : ExtendedFCBType;
  69. begin
  70.   fillChar(FCB,sizeof(FCB),#0);  {initialize FCB With nulls }
  71.   With FCB do
  72.     begin
  73.       ExtendedFCBflag:= $ff;      { always }
  74.       Attr           := VolumeID; {defined in the Dos Unit}
  75.       DriveID        := 0;        {default drive}
  76.       move(CurrentVolumeLabel[1],FileName,8); {you have to put these in}
  77.      move(CurrentVolumeLabel[9],FileExt ,3); {For some silly reason   }
  78.     end; { With FCB do }
  79.  
  80.   { set up regs For Dos call }
  81.   fillChar(regs,sizeof(regs),#0); {initialize regs With nulls}
  82.   regs.ah:= $13; {Dos 1.0 delete File Function}
  83.   regs.ds:= seg(FCB);
  84.   regs.dx:= ofs(FCB);
  85.   MsDos(regs); {call Dos to delete the volume Label }
  86.   if regs.al=0 then Writeln('Success -- volume Label deleted.')
  87.   else Writeln('Failure -- volume Label not deleted.');
  88. end; { of DelVolumeLabel }
  89.  
  90. Procedure WriteVolumeLabel(CurrentVolumeLabel:String11);
  91. {create volume Label from disk in current drive}
  92. Var
  93.   regs : Registers;
  94.   FCB  : ExtendedFCBType;
  95. begin
  96.   fillChar(FCB,sizeof(FCB),#0);  {initialize FCB With nulls }
  97.   With FCB do
  98.     begin
  99.       ExtendedFCBflag:= $ff;      { always }
  100.       Attr           := VolumeID; {defined in the Dos Unit}
  101.       DriveID        := 0;        {default drive}
  102.       move(CurrentVolumeLabel[1],FileName,8);
  103.       move(CurrentVolumeLabel[9],FileExt ,3);
  104.     end; { With FCB do }
  105.  
  106.   { set up regs For Dos call }
  107.   fillChar(regs,sizeof(regs),#0); {initialize regs With nulls}
  108.   regs.ah:= $16; {Dos 1.0 create File Function}
  109.   regs.ds:= seg(FCB);
  110.   regs.dx:= ofs(FCB);
  111.   MsDos(regs); {call Dos to delete the volume Label }
  112.   if regs.al=0 then Writeln('Success -- volume Label written.')
  113.   else Writeln('Failure -- volume Label not written.');
  114. end; { of WriteVolumeLabel }
  115.  
  116. begin { test Program }
  117.   getdir(0,oldir); { save current directory }
  118.   chdir('a:');     { play With diskette in A: }
  119.   Writeln('Old volume Label: ',GetCurrentVolumeLabel);
  120.   DelVolumeLabel(GetCurrentVolumeLabel);
  121.   WriteVolumeLabel('10987654321');
  122.   Writeln('New volume Label: ',GetCurrentVolumeLabel);
  123.   chdir(oldir); { go back to original directory }
  124. end. { test program }
  125.